﻿Imports System.IO
Imports TyranntEngine

Public Class CharacterDatabaseAccess

    Private db As New TyranntCharacterDatasourceDataContext
    Private _LastError As New Exception
    Private _causedError As Boolean = False

#Region "Character Code"

    Public Function DeleteCharacter(ByVal CharacterID As Integer) As String
        ' First we get the character object from the database
        Dim aChar As character = PullCharacter(CharacterID)
        If IsNothing(aChar) Then
            Return Failed("DeleteCharacter")
        ElseIf aChar.name = "" Then
            Return "[#]charnotexist"
        End If

        ' Then we have to delete the skills for this character
        Try
            Dim result = From aSkill In db.characterSkills _
                         Where aSkill.characterID = CharacterID _
                         Select aSkill
            db.characterSkills.DeleteAllOnSubmit(result)
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteCharacter")
        End Try

        ' And the items for this character
        Try
            Dim result = From anItem In db.characterItems _
                         Where anItem.characterID = CharacterID _
                         Select anItem
            db.characterItems.DeleteAllOnSubmit(result)
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteCharacter")
        End Try

        Try
            db.characters.DeleteOnSubmit(aChar)
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteCharacter")
        End Try

        ' if all went well we return an empty string
        Return ""
    End Function

    Public Function GetCharacterGuild(ByVal charachterID As Integer) As String
        Try
            Dim result = (From aCh In db.characters _
                        Where charachterID = charachterID _
                        Select aCh).ToList
            If result.Count > 0 Then
                Return "[#]guildID=[" + result(0).guildID.ToString + "]"
            End If
            Return "[#]charnotfound"
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetCharacterGuild")
        End Try
    End Function

    Public Function NewCharacter(ByVal userID As Integer, ByVal name As String) As String
        ' check to see if the character already exists
        Dim aChar As character = GetCharacter(name)
        If IsNothing(aChar) Then
            Return Failed("GetCharacter")
        ElseIf aChar.name <> "" Then
            Return "[#]charexist"
        End If

        ' We know that a character with this name does not exist, so add character.
        Dim aCharacter As New character
        aChar.userID = userID
        aChar.name = name
        Try
            db.characters.InsertOnSubmit(aChar)
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("NewCharacter")
        End Try

        ' The character has been added so return the xml of this character with the ID
        Return GetCharacterXML(name)
    End Function

    Public Function SelectRace(ByVal characterID As Integer, ByVal raceID As Integer, ByVal isMale As Boolean, ByVal imageName As String) As String
        ' First check that the race exists
        Dim aRace As race = PullRace(raceID)
        If IsNothing(aRace) = True Then
            Return Failed("PullRace")
        End If
        If aRace.name = "" Then
            Return "[#]racenotexist[" + raceID.ToString + "]"
        End If

        ' Now get the character from the database and add 
        ' the new information to the character.
        Dim aChar As character = GetCharacter(characterID)
        If IsNothing(aChar) Then
            Return Failed("GetCharacter")   ' Get Character cause exception
        ElseIf aChar.name = "" Then
            Return "[#]charnotexist"        ' The character doesn't exist so report error
        End If

        aChar.raceID = raceID
        aChar.isMale = isMale
        aChar.racePortrait = imageName

        Try
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("SelectRace")
        End Try

        Return GetCharacterXML(aChar)
    End Function

    Public Function SelectGuild(ByVal characterID As Integer, ByVal guildID As Integer) As String
        ' first check that the guild exists
        Dim aGuild As guild = PullGuild(guildID)
        If IsNothing(aGuild) = True Then
            Return Failed("PullGuild")
        End If
        If aGuild.name = "" Then
            Return "[#]guildnotexist[" + guildID.ToString + "]"
        End If
        ' Second, check that the initial class exists
        Dim aClass As [class] = PullClass(aGuild.initialClassID)
        If IsNothing(aClass) = True Then
            Return Failed("PullClass")
        End If
        If aClass.name = "" Then
            Return "[#]classnotexist[" + aGuild.initialClassID.ToString + "]"
        End If

        ' Now get the character from the database and add 
        ' the new information to the character.
        Dim aChar As character = GetCharacter(characterID)
        If IsNothing(aChar) Then
            Return Failed("GetCharacter")   ' Get Character cause exception
        ElseIf aChar.name = "" Then
            Return "[#]charnotexist"        ' The character doesn't exist so report error
        End If

        aChar.guildID = guildID
        aChar.classID = aClass.classID

        Try
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("SelectGuild")
        End Try

        ' Now we need to add the default skills and inventory items for this character
        ' based on the class
        Try
            Dim result = (From aSkill In db.classSkillPools _
                          Where aSkill.classID = aChar.classID _
                          Select aSkill).ToList
            Dim found As Boolean = False
            For Each aSkill In result
                Dim charSkill As New characterSkill
                charSkill.characterID = aChar.characterID
                charSkill.skillID = aSkill.skillID
                db.characterSkills.InsertOnSubmit(charSkill)
                db.SubmitChanges()
                found = True
            Next
        Catch ex As Exception
            _LastError = ex
            Return Failed("SelectGuild")
        End Try
        Try
            Dim result = (From anItem In db.classItemPools _
                          Where anItem.classID = aChar.classID _
                          Select anItem).ToList
            Dim found As Boolean = False
            For Each anItem In result
                Dim charItem As New characterItem
                charItem.characterID = aChar.characterID
                charItem.itemID = anItem.itemID
                db.characterItems.InsertOnSubmit(charItem)
                db.SubmitChanges()
                found = True
            Next
        Catch ex As Exception
            _LastError = ex
            Return Failed("SelectGuild")
        End Try

        Return GetCharacterXML(aChar)
    End Function

    Public Function GenerateStats(ByVal characterID As Integer) As String
        ' First we need to check that the character exsits
        ' and get the character information from the database
        Dim aChar As character = GetCharacter(characterID)
        If IsNothing(aChar) Then
            Return Failed("GetCharacter")   ' Get Character cause exception
        ElseIf aChar.name = "" Then
            Return "[#]charnotexist"        ' The character doesn't exist so report error
        End If

        ' Now lets work out the Race stat mods
        Dim strMod As Integer = aChar.race.strengthModifier
        Dim dexMod As Integer = aChar.race.dexterityModifier
        Dim intMod As Integer = aChar.race.intelligenceModifier

        ' Now lets work out the minimum requirements for the character class
        Dim minStr As Integer = aChar.class.minStr
        Dim minDex As Integer = aChar.class.minDex
        Dim minInt As Integer = aChar.class.minInt

        ' Now we need to roll the dice for each stat until we meet the minimum requirements
        ' for the characters class.
        Dim emergencyExit As Integer = 0
        Do
            Dim dice As New diceRoll
            dice.FromString = "4d6"
            aChar.strength = dice.Roll + strMod
            aChar.dexterity = dice.Roll + dexMod
            aChar.intelligence = dice.Roll + intMod

            If aChar.strength >= minStr And aChar.dexterity >= minDex And aChar.intelligence >= minInt Then
                Exit Do
            End If
            emergencyExit += 1
            If emergencyExit > 100 Then
                Return "[#]toomanydicerolls"
            End If
        Loop
        Try
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("GenerateStats")
        End Try
        Return GetCharacterXML(aChar)
    End Function

    Private Function GetCharacter(ByVal name As String) As character
        Try
            Dim result = (From playerCharacter In db.characters _
                          Where playerCharacter.name = name _
                          Select playerCharacter).ToList
            If result.Count = 0 Then
                Return New character
            Else
                Return result(0)
            End If
        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Public Function GetPlayerCharacter(ByVal characterID As Integer) As String
        Dim aChar As character = GetCharacter(characterID)
        If IsNothing(aChar) Then
            Return Failed("GetCharacter")
        ElseIf aChar.name = "" Then
            Return "[#]characternotexist[" + characterID.ToString + "]"
        End If
        Return GetCharacterXML(aChar)
    End Function

    Public Function GetCharacters(ByVal userID As Integer) As String
        Try
            Dim result = <characters>
                             <%= From aChar In db.characters _
                                 Where aChar.userID = userID _
                                 Select <character id=<%= aChar.characterID %>>
                                            <name><%= aChar.name %></name>
                                            <race><%= aChar.race.name %></race>
                                            <class><%= aChar.class.name %></class>
                                        </character> %>
                         </characters>
            Return result.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetCharacters")
        End Try
    End Function

    Private Function GetCharacter(ByVal id As Integer) As character
        Try
            Dim result = (From playerCharacter In db.characters _
                          Where playerCharacter.characterID = id _
                          Select playerCharacter).ToList
            If result.Count = 0 Then
                Return New character
            Else
                Return result(0)
            End If
        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Private Function GetCharacterXML(ByVal name As String) As String
        Dim aChar As character = GetCharacter(name)
        If IsNothing(aChar) Then
            Return Failed("GetCharacter")
        ElseIf aChar.name = "" Then
            Return "[#]characternotexist[" + name + "]"
        End If

        Dim _character As New PlayerCharacter
        Try
            _character.ID = aChar.characterID
            _character.UserID = aChar.userID
            _character.Name = aChar.name
            If IsNothing(aChar.strength) = False Then
                _character.Strength = CInt(aChar.strength)
            End If
            If IsNothing(aChar.dexterity) = False Then
                _character.Dexterity = CInt(aChar.dexterity)
            End If
            If IsNothing(aChar.intelligence) = False Then
                _character.Intelligence = CInt(aChar.intelligence)
            End If
            If IsNothing(aChar.hitPoints) = False Then
                _character.HitPoints = CInt(aChar.hitPoints)
            End If
            If IsNothing(aChar.spellPoints) = False Then
                _character.SpellPoints = CInt(aChar.spellPoints)
            End If
            If IsNothing(aChar.isMale) = False Then
                _character.IsMale = CBool(aChar.isMale)
            End If
            If IsNothing(aChar.raceID) = False Then
                _character.RaceID = CInt(aChar.raceID)
            End If
            If IsNothing(aChar.racePortrait) = False Then
                _character.RacePortraitName = aChar.racePortrait
            End If
            If IsNothing(aChar.guildID) = False Then
                _character.GuildID = CInt(aChar.guildID)
            End If
            If IsNothing(aChar.classID) = False Then
                _character.ClassID = CInt(aChar.classID)
            End If
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetCharacterXML")
        End Try

        Return _character.ToXElement.ToString
    End Function

    Private Function GetCharacterXML(ByVal aChar As character) As String
        Dim _character As New PlayerCharacter
        Try
            _character.ID = aChar.characterID
            _character.UserID = aChar.userID
            _character.Name = aChar.name
            If IsNothing(aChar.strength) = False Then
                _character.Strength = CInt(aChar.strength)
            End If
            If IsNothing(aChar.dexterity) = False Then
                _character.Dexterity = CInt(aChar.dexterity)
            End If
            If IsNothing(aChar.intelligence) = False Then
                _character.Intelligence = CInt(aChar.intelligence)
            End If
            If IsNothing(aChar.hitPoints) = False Then
                _character.HitPoints = CInt(aChar.hitPoints)
            End If
            If IsNothing(aChar.spellPoints) = False Then
                _character.SpellPoints = CInt(aChar.spellPoints)
            End If
            If IsNothing(aChar.isMale) = False Then
                _character.IsMale = CBool(aChar.isMale)
            End If
            If IsNothing(aChar.raceID) = False Then
                _character.RaceID = CInt(aChar.raceID)
            End If
            If IsNothing(aChar.racePortrait) = False Then
                _character.RacePortraitName = aChar.racePortrait
            End If
            If IsNothing(aChar.guildID) = False Then
                _character.GuildID = CInt(aChar.guildID)
            End If
            If IsNothing(aChar.classID) = False Then
                _character.ClassID = CInt(aChar.classID)
            End If
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetCharacterXML")
        End Try

        Return _character.ToXElement.ToString
    End Function

    Public Function PullCharacter(ByVal characterID As Integer) As character
        Try
            Dim result = (From aChar In db.characters _
                                  Where aChar.characterID = characterID _
                                  Select aChar).ToList
            If result.Count > 0 Then
                Return result(0)
            Else
                Return New character
            End If

        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Public Function GetCharacterSkills(ByVal characterID As Integer) As String
        Try
            Dim result = <skills>
                             <%= From aSkill In db.characterSkills _
                                 Where aSkill.characterID = characterID _
                                 Select <skill id=<%= aSkill.skillID %>>
                                            <name><%= aSkill.skill.name %></name>
                                            <desc><%= aSkill.skill.description %></desc>
                                        </skill> %>
                         </skills>
            Return result.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetCharacterSkills")
        End Try
    End Function

    Public Function GetCharacterItems(ByVal characterID As Integer) As String
        Try
            Dim result = <items>
                             <%= From anItem In db.characterItems _
                                 Where anItem.characterID = characterID _
                                 Select <item id=<%= anItem.itemID %>>
                                            <name><%= anItem.item.name %></name>
                                            <desc><%= anItem.item.description %></desc>
                                            <icon><%= anItem.item.iconImage %></icon>
                                            <image><%= anItem.item.descriptionImage %></image>
                                        </item> %>
                         </items>
            Return result.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetCharacterItems")
        End Try
    End Function

    Public Function BelongToUser(ByVal userID As Integer, ByVal characterID As Integer) As Boolean
        Dim aChar = PullCharacter(characterID)
        If IsNothing(aChar) Then
            Return False
        ElseIf aChar.name = "" Then
            Return False
        ElseIf aChar.userID = userID Then
            Return True
        Else
            Return False
        End If
    End Function
#End Region

#Region "Race Code"

    Public Function UpdateRace(ByVal raceXML As String) As String
        Dim _race As New CharacterRace
        _race.LoadXML(raceXML)

        Try
            Dim aRace As race = PullRace(_race.RaceID)
            If IsNothing(aRace) Then
                Return Failed("PullRace")
            ElseIf aRace.name = "" Then
                Return "[#]racenotexist[" + _race.RaceID.ToString + "]"
            End If
            aRace.name = _race.Name
            aRace.description = _race.Description
            aRace.strengthModifier = _race.StrengthModifier
            aRace.dexterityModifier = _race.DexterityModifier
            aRace.intelligenceModifier = _race.IntelligenceModifier
            aRace.unknownSexPicture = _race.UnknownSexImage
            aRace.maleSexPicture = _race.MaleImage
            aRace.femaleSexPicture = _race.FemaleImage
            aRace.malePortrait1 = _race.MalePortrait(0)
            aRace.malePortrait2 = _race.MalePortrait(1)
            aRace.malePortrait3 = _race.MalePortrait(2)
            aRace.malePortrait4 = _race.MalePortrait(3)
            aRace.malePortrait5 = _race.MalePortrait(4)
            aRace.malePortrait6 = _race.MalePortrait(5)
            aRace.femalePortrait1 = _race.FemalePortrait(0)
            aRace.femalePortrait2 = _race.FemalePortrait(1)
            aRace.femalePortrait3 = _race.FemalePortrait(2)
            aRace.femalePortrait4 = _race.FemalePortrait(3)
            aRace.femalePortrait5 = _race.FemalePortrait(4)
            aRace.femalePortrait6 = _race.FemalePortrait(5)

            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("UpdateRace")
        End Try

    End Function

    Private Function PullRace(ByVal raceID As Integer) As race
        Try
            Dim result = (From race In db.races _
                                  Where race.raceID = raceID _
                                  Select race).ToList
            If result.Count > 0 Then
                Return result(0)
            Else
                Return New race
            End If

        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Public Function AddRace(ByVal raceXML As String) As String
        Dim _race As New CharacterRace
        _race.LoadXML(raceXML)

        Dim aRace As New race

        aRace.name = _race.Name
        If CheckRaceExists(aRace.name) = True Then
            Return "[#]raceexists"
        Else
            If _causedError = True Then
                Return Failed("CheckRaceExists")
            End If
        End If
        aRace.description = _race.Description
        aRace.strengthModifier = _race.StrengthModifier
        aRace.dexterityModifier = _race.DexterityModifier
        aRace.intelligenceModifier = _race.IntelligenceModifier
        aRace.unknownSexPicture = _race.UnknownSexImage
        aRace.maleSexPicture = _race.MaleImage
        aRace.femaleSexPicture = _race.FemaleImage
        aRace.malePortrait1 = _race.MalePortrait(0)
        aRace.malePortrait2 = _race.MalePortrait(0)
        aRace.malePortrait3 = _race.MalePortrait(0)
        aRace.malePortrait4 = _race.MalePortrait(0)
        aRace.malePortrait5 = _race.MalePortrait(0)
        aRace.malePortrait6 = _race.MalePortrait(0)
        aRace.femalePortrait1 = _race.FemalePortrait(0)
        aRace.femalePortrait2 = _race.FemalePortrait(0)
        aRace.femalePortrait3 = _race.FemalePortrait(0)
        aRace.femalePortrait4 = _race.FemalePortrait(0)
        aRace.femalePortrait5 = _race.FemalePortrait(0)
        aRace.femalePortrait6 = _race.FemalePortrait(0)

        ' Race doesn't exist already so we can now add the race
        Try
            db.races.InsertOnSubmit(aRace)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddRace")
        End Try
    End Function

    Private Function CheckRaceExists(ByVal name As String) As Boolean
        _causedError = False
        Try
            Dim result = (From race In db.races _
                                 Where race.name = name _
                                 Select race).ToList
            If result.Count = 0 Then
                Return False
            Else
                Return True
            End If
        Catch ex As Exception
            _LastError = ex
            _causedError = True
            Return False
        End Try
    End Function

    Public Function GetRace(ByVal raceID As Integer) As String
        Try
            Dim aRace = (From race In db.races _
                            Where race.raceID = raceID _
                            Select race).ToList

            If aRace.Count = 0 Then
                Return "[#]racenotexist"
            End If

            Dim chrRace As New CharacterRace
            chrRace.RaceID = aRace(0).raceID
            chrRace.Name = aRace(0).name
            chrRace.Description = aRace(0).description
            chrRace.StrengthModifier = aRace(0).strengthModifier
            chrRace.DexterityModifier = aRace(0).dexterityModifier
            chrRace.IntelligenceModifier = aRace(0).intelligenceModifier
            chrRace.UnknownSexImage = aRace(0).unknownSexPicture
            chrRace.MaleImage = aRace(0).maleSexPicture
            chrRace.FemaleImage = aRace(0).femaleSexPicture
            chrRace.MalePortrait(0) = aRace(0).malePortrait1
            chrRace.MalePortrait(1) = aRace(0).malePortrait2
            chrRace.MalePortrait(2) = aRace(0).malePortrait3
            chrRace.MalePortrait(3) = aRace(0).malePortrait4
            chrRace.MalePortrait(4) = aRace(0).malePortrait5
            chrRace.MalePortrait(5) = aRace(0).malePortrait6
            chrRace.FemalePortrait(0) = aRace(0).femalePortrait1
            chrRace.FemalePortrait(1) = aRace(0).femalePortrait2
            chrRace.FemalePortrait(2) = aRace(0).femalePortrait3
            chrRace.FemalePortrait(3) = aRace(0).femalePortrait4
            chrRace.FemalePortrait(4) = aRace(0).femalePortrait5
            chrRace.FemalePortrait(5) = aRace(0).femalePortrait6

            Return chrRace.ToXElement.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetRace")
        End Try
    End Function

    Public Function GetRaces() As String
        Try
            Dim raceListXML = <races>
                                  <%= From race In db.races _
                                      Select <race id=<%= race.raceID %>>
                                                 <name><%= race.name %></name>
                                             </race> %>
                              </races>
            Return raceListXML.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetRaceList")
        End Try
    End Function

    Public Function DeleteRace(ByVal raceID As Integer) As String
        Dim aRace As race = PullRace(raceID)
        If IsNothing(aRace) = True Then
            Return Failed("PullRace")
        End If
        If aRace.name = "" Then
            Return "[#]racenotexist[" + raceID.ToString + "]"
        End If

        Try
            db.races.DeleteOnSubmit(aRace)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteRace[" + raceID.ToString + "]")
        End Try
    End Function

#End Region

#Region "Skill Code"

    Public Function AddSkill(ByVal name As String, ByVal description As String) As String
        If CheckSkillExists(name) = True Then
            If _causedError = True Then
                Return Failed("CheckSkillExists")
            End If
            Return "[#]skillexists"
        Else
            If _causedError = True Then
                Return Failed("CheckSkillExists")
            End If
        End If
        Dim aSkill As New skill
        aSkill.name = name
        aSkill.description = description
        ' Skill doesn't exist already so we can now add the skill
        Try
            db.skills.InsertOnSubmit(aSkill)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddSkill")
        End Try
    End Function

    Public Function UpdateSkill(ByVal skillID As Integer, ByVal name As String, ByVal description As String) As String
        Dim aSkill As skill = PullSkill(skillID)
        If IsNothing(aSkill) Then
            Return Failed("PullSkill")
        ElseIf aSkill.name = "" Then
            Return "[#]skillnotexist[" + skillID.ToString + "]"
        End If
        aSkill.name = name
        aSkill.description = description

        Try
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("UpdateSkill")
        End Try

    End Function


    Public Function DeleteSkill(ByVal skillID As Integer) As String
        Dim aSkill As skill = PullSkill(skillID)
        If IsNothing(aSkill) = True Then
            Return Failed("PullSkill")
        End If
        If aSkill.name = "" Then
            Return "[#]skillnotexist[" + skillID.ToString + "]"
        End If

        Try
            db.skills.DeleteOnSubmit(aSkill)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteSkill[" + skillID.ToString + "]")
        End Try
    End Function

    Private Function PullSkill(ByVal skillID As Integer) As skill
        Try
            Dim result = (From skill In db.skills _
                                  Where skill.skillID = skillID _
                                  Select skill).ToList
            If result.Count > 0 Then
                Return result(0)
            Else
                Return New skill
            End If

        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Private Function CheckSkillExists(ByVal name As String) As Boolean
        _causedError = False
        Try
            Dim result = (From skill In db.skills _
                                 Where skill.name = name _
                                 Select skill).ToList
            If result.Count = 0 Then
                Return False
            Else
                Return True
            End If
        Catch ex As Exception
            _LastError = ex
            _causedError = True
            Return False
        End Try
    End Function

    Public Function GetSkills() As String
        Try
            Dim skillListXML = <skills>
                                   <%= From skill In db.skills _
                                       Select <skill id=<%= skill.skillID %>>
                                                  <name><%= skill.name %></name>
                                                  <desc><%= skill.description %></desc>
                                              </skill> %>
                               </skills>
            Return skillListXML.ToString()
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetSkills")
        End Try
    End Function

#End Region

#Region "Item Code"

    Public Function UpdateItem(ByVal itemXML As String) As String
        Dim _item As New InventoryItem
        _item.LoadXML(itemXML)

        Try
            Dim anItem As item = PullItem(_item.ID)
            If IsNothing(anItem) Then
                Return Failed("PullItem")
            ElseIf anItem.name = "" Then
                Return "[#]itemnotexist[" + _item.ID.ToString + "]"
            End If
            anItem.name = _item.Name
            anItem.description = _item.Description
            anItem.itemTypeID = _item.ItemTypeID
            ' Now check the item type exists
            Dim anIT = PullItemType(anItem.itemTypeID)
            If IsNothing(anIT) Then
                Return Failed("PullItemType")
            ElseIf anIT.name = "" Then
                Return "[#]itemtypenotexist[" + anItem.itemTypeID.ToString + "]"
            End If
            anItem.iconImage = _item.IconImageName
            anItem.descriptionImage = _item.DescriptiveImageName
            anItem.requiredSkillID = _item.RequiredSkillID
            ' Now check the skill exists
            Dim aSkill = PullSkill(anItem.requiredSkillID)
            If IsNothing(aSkill) Then
                Return Failed("PullSkill")
            ElseIf aSkill.name = "" Then
                Return "[#]requiredskillnotexist[" + anItem.requiredSkillID.ToString + "]"
            End If
            anItem.healingDice = _item.HealDice.ToString
            anItem.damageDice = _item.DamageDice.ToString
            anItem.defenceValue = _item.DefenceValue
            anItem.keyNumber = _item.KeyNumber
            If _item.ChargesItemID <> 0 Then
                anItem.chargesItemID = _item.ChargesItemID
                ' Now check the item type exists
                Dim anI = PullItem(anItem.chargesItemID)
                If IsNothing(anI) Then
                    Return Failed("PullItem")
                ElseIf anI.name = "" Then
                    Return "[#]chargesitemnotexist[" + anItem.chargesItemID.ToString + "]"
                End If
            End If
            anItem.numberCharges = _item.NumberOfCharges

            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("UpdateRace")
        End Try

    End Function

    Private Function PullItem(ByVal itemID As Integer) As item
        Try
            Dim result = (From item In db.items _
                                  Where item.itemID = itemID _
                                  Select item).ToList
            If result.Count > 0 Then
                Return result(0)
            Else
                Return New item
            End If

        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Public Function AddItemType(ByVal name As String, ByVal description As String) As String
        Try
            Dim newItemType As New itemType
            newItemType.name = name
            newItemType.description = description
            db.itemTypes.InsertOnSubmit(newItemType)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return ex.ToString
        End Try
    End Function

    Public Function GetItemTypeCount() As Integer
        Try
            Dim result = From itemType In db.itemTypes _
                         Select itemType
            Return result.Count
        Catch ex As Exception
            _LastError = ex
            Return -2
        End Try
    End Function

    Private Function PullItemType(ByVal itemTypeID As Integer) As itemType
        Try
            Dim result = (From itemType In db.itemTypes _
                                  Where itemType.itemTypeID = itemTypeID _
                                  Select itemType).ToList
            If result.Count > 0 Then
                Return result(0)
            Else
                Return New itemType
            End If

        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Public Function AddItem(ByVal itemXML As String) As String
        Dim _item As New InventoryItem
        _item.LoadXML(itemXML)

        Dim anItem As New item

        anItem.name = _item.Name
        If CheckItemExists(anItem.name) = True Then
            Return "[#]itemexists"
        Else
            If _causedError = True Then
                Return Failed("CheckItemExists")
            End If
        End If
        anItem.description = _item.Description
        anItem.itemTypeID = _item.ItemTypeID
        ' Now check the item type exists
        Dim anIT = PullItemType(anItem.itemTypeID)
        If IsNothing(anIT) Then
            Return Failed("PullItemType")
        ElseIf anIT.name = "" Then
            Return "[#]itemtypenotexist[" + anItem.itemTypeID.ToString + "]"
        End If
        anItem.iconImage = _item.IconImageName
        anItem.descriptionImage = _item.DescriptiveImageName
        anItem.requiredSkillID = _item.RequiredSkillID
        ' Now check the skill exists
        Dim aSkill = PullSkill(anItem.requiredSkillID)
        If IsNothing(aSkill) Then
            Return Failed("PullSkill")
        ElseIf aSkill.name = "" Then
            Return "[#]requiredskillnotexist[" + anItem.requiredSkillID.ToString + "]"
        End If
        anItem.healingDice = _item.HealDice.ToString
        anItem.damageDice = _item.DamageDice.ToString
        anItem.defenceValue = _item.DefenceValue
        anItem.keyNumber = _item.KeyNumber
        If _item.ChargesItemID <> 0 Then
            anItem.chargesItemID = _item.ChargesItemID
            ' Now check the item type exists
            Dim anI = PullItem(anItem.chargesItemID)
            If IsNothing(anI) Then
                Return Failed("PullItem")
            ElseIf anI.name = "" Then
                Return "[#]chargesitemnotexist[" + anItem.chargesItemID.ToString + "]"
            End If
        End If
        anItem.numberCharges = _item.NumberOfCharges
        
        ' Race doesn't exist already so we can now add the race
        Try
            db.items.InsertOnSubmit(anItem)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddItem")
        End Try
    End Function

    Private Function CheckItemExists(ByVal name As String) As Boolean
        _causedError = False
        Try
            Dim result = (From item In db.items _
                          Where item.name = name _
                          Select item).ToList
            If result.Count = 0 Then
                Return False
            Else
                Return True
            End If
        Catch ex As Exception
            _LastError = ex
            _causedError = True
            Return False
        End Try
    End Function

    Public Function GetItem(ByVal itemID As Integer) As String
        Try
            Dim anItem = (From item In db.items _
                            Where item.itemID = itemID _
                            Select item).ToList

            If anItem.Count = 0 Then
                Return "[#]itemnotexist"
            End If

            Dim invItem As New InventoryItem
            invItem.ID = anItem(0).itemID
            invItem.Name = anItem(0).name
            invItem.Description = anItem(0).description
            invItem.ItemTypeID = anItem(0).itemTypeID
            invItem.IconImageName = anItem(0).iconImage
            invItem.DescriptiveImageName = anItem(0).descriptionImage
            invItem.RequiredSkillID = anItem(0).requiredSkillID
            invItem.HealDice.FromString = anItem(0).healingDice
            invItem.DamageDice.FromString = anItem(0).damageDice
            invItem.DefenceValue = anItem(0).defenceValue
            invItem.KeyNumber = anItem(0).keyNumber
            invItem.ChargesItemID = anItem(0).chargesItemID
            invItem.NumberOfCharges = anItem(0).numberCharges

            Return invItem.ToXElement.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetItem")
        End Try
    End Function

    Public Function GetItems() As String
        Try
            Dim itemListXML = <items>
                                  <%= From item In db.items _
                                      Select <item id=<%= item.itemID %>>
                                                 <name><%= item.name %></name>
                                                 <desc><%= item.description %></desc>
                                                 <iconImage><%= item.iconImage %></iconImage>
                                             </item> %>
                              </items>
            Return itemListXML.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetItems")
        End Try
    End Function

    Public Function GetItemTypes() As String
        Try
            Dim itemTypeListXML = <itemTypes>
                                      <%= From itemType In db.itemTypes _
                                          Select <itemType id=<%= itemType.itemTypeID %>>
                                                     <name><%= itemType.name %></name>
                                                     <desc><%= itemType.description %></desc>
                                                 </itemType> %>
                                  </itemTypes>
            Return itemTypeListXML.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetItemTypes")
        End Try
    End Function

    Public Function DeleteItem(ByVal itemID As Integer) As String
        Dim anItem As item = PullItem(itemID)
        If IsNothing(anItem) = True Then
            Return Failed("PullItem")
        End If
        If anItem.name = "" Then
            Return "[#]itemnotexist[" + itemID.ToString + "]"
        End If

        Try
            db.items.DeleteOnSubmit(anItem)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteItem[" + itemID.ToString + "]")
        End Try
    End Function

#End Region

#Region "Class Code"
    Public Function AddClass(ByVal classXML As String) As String
        Dim _class As New CharacterClass
        Try
            _class.LoadXML(classXML)
        Catch ex As Exception
            _LastError = ex
            Return FailedXML("AddClass", classXML)
        End Try

        If CheckClassExists(_class.Name) = True Then
            If _causedError = True Then
                Return Failed("CheckClassExists")
            End If
            Return "[#]classexists"
        Else
            If _causedError = True Then
                Return Failed("CheckClassExists")
            End If
        End If
        Dim aClass As New [class]
        aClass.name = _class.Name
        aClass.description = _class.Description
        aClass.minStr = _class.MinimumStrength
        aClass.minDex = _class.MinimumDexterity
        aClass.minInt = _class.MinimumIntelligence
        ' Class doesn't exist already so we can now add the Class
        Try
            db.classes.InsertOnSubmit(aClass)
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddClass")
        End Try

        ' Next we need to add the initial skills to the skill pool
        ' but first we need to get the classID.
        Dim classID As Integer = GetClassID(aClass.name)
        If classID < 0 Then
            Return ErrorRoutine(classID, "", "GetClassID")
        End If
        Return AddClassPools(_class, classID)
    End Function

    Private Function AddClassPools(ByVal _class As CharacterClass, ByVal classID As Integer) As String
        ' Now check that there are none already with this class
        Try
            Dim result = (From skill In db.classSkillPools _
                        Where skill.classID = classID _
                        Select skill).ToList
            If result.Count <> 0 Then
                Return ErrorRoutine(-4, "classalreadyinskillpool", "AddClassPools")
            End If
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddClassPools")
        End Try
        ' now add all the skills for this class to the classSkillPool
        Try
            For Each skillID As Integer In _class.Skills
                Dim skillP As New classSkillPool
                skillP.classID = classID
                skillP.skillID = skillID
                db.classSkillPools.InsertOnSubmit(skillP)
                db.SubmitChanges()
            Next
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddClassPools")
        End Try

        ' Now check that there are items already with this class
        Try
            Dim result = (From item In db.classItemPools _
                        Where item.classID = classID _
                        Select item).ToList
            If result.Count <> 0 Then
                Return ErrorRoutine(-4, "itemalreadyinskillpool", "AddClassPools")
            End If
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddClassPools")
        End Try
        ' now add all the skills for this class to the classSkillPool
        Try
            For Each itemID As Integer In _class.Items
                Dim itemP As New classItemPool
                itemP.classID = classID
                itemP.itemID = itemID
                db.classItemPools.InsertOnSubmit(itemP)
                db.SubmitChanges()
            Next
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddClassPools")
        End Try
        Return ""
    End Function

    Public Function GetClasses() As String
        ' first get a list of class objects
        Try
            Dim result = <classes>
                             <%= From cls In db.classes _
                                 Select <class id=<%= cls.classID %>>
                                            <name><%= cls.name %></name>
                                        </class> %>
                         </classes>

            Return result.ToString
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetClasses")
        End Try
    End Function

    Public Function GetClass(ByVal classID As Integer) As String
        ' lets generate a CharacterClass object 
        Dim _class As New CharacterClass
        ' first we need to get the general class information added to _class
        Dim aClass As [class] = PullClass(classID)
        If IsNothing(aClass) Then
            Return Failed("GetClass")
        ElseIf aClass.name = "" Then
            Return ErrorRoutine(-1, "class", "GetClass")
        End If
        _class.ID = aClass.classID
        _class.Name = aClass.name
        _class.Description = aClass.description
        _class.MinimumStrength = aClass.minStr
        _class.MinimumDexterity = aClass.minDex
        _class.MinimumIntelligence = aClass.minInt
        ' we now need to get all the skills associated with this class
        Try
            Dim skills = From skill In db.classSkillPools _
                         Where skill.classID = classID _
                         Select skill
            For Each aSkill In skills
                _class.Skills.Add(aSkill.skillID)
            Next
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetClass[skill]")
        End Try

        ' now we need to all the items associated with this class
        Try
            Dim items = From item In db.classItemPools _
                         Where item.classID = classID _
                         Select item
            For Each anItem In items
                _class.Items.Add(anItem.itemID)
            Next
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetClass[item]")
        End Try

        ' Now let the CharacterClass class generate the XML for us
        Return _class.ToXElement.ToString
    End Function

    Public Function UpdateClass(ByVal classXML As String) As String
        ' first lets generate the class XElement and create some easy to use string
        Dim _class As New CharacterClass
        Try
            _class.LoadXML(classXML)
        Catch ex As Exception
            _LastError = ex
            Return FailedXML("UpdateClass", classXML)
        End Try
        Dim classID As Integer = _class.ID
        If CheckClassExists(_class.Name) = False Then
            If _causedError = True Then
                Return Failed("CheckClassExists")
            End If
            Return ErrorRoutine(-1, "class", "UpdateClass")
        Else
            If _causedError = True Then
                Return Failed("CheckClassExists")
            End If
        End If

        ' now lets get the class object we want to update
        Dim aClass As [class] = PullClass(classID)
        Try
            ' now we have the class object lets update it
            aClass.description = _class.Description
            aClass.name = _class.Name
            aClass.minStr = _class.MinimumStrength
            aClass.minDex = _class.MinimumDexterity
            aClass.minInt = _class.MinimumIntelligence
            db.SubmitChanges()
        Catch ex As Exception
            _LastError = ex
            Return Failed("UpdateClass")
        End Try
        ' Now lets get rid of the class pools for this class
        Dim result = DeleteClassPools(classID)
        If result <> "" Then
            Return result
        End If
        ' And finally put in the new class pool information
        Return AddClassPools(_class, classID)
    End Function

    Private Function DeleteClassPools(ByVal classID As Integer) As String
        Try
            ' first try to get a collection of skill objects
            Dim skills = From skill In db.classSkillPools _
                         Where skill.classID = classID _
                         Select skill
            ' and delete them
            If skills.Count > 0 Then
                db.classSkillPools.DeleteAllOnSubmit(skills)
            Else
                Return ErrorRoutine(-1, "skill", "DeleteClassPools")
            End If
            ' next, get a collection of item objects
            Dim items = From item In db.classItemPools _
                        Where item.classID = classID _
                        Select item
            ' and delete them
            If items.Count > 0 Then
                db.classItemPools.DeleteAllOnSubmit(items)
            Else
                Return ErrorRoutine(-1, "item", "DeleteClassPools")
            End If
            ' now submit the changes
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteClassPools")
        End Try
    End Function

    Public Function DeleteClass(ByVal classID As Integer) As String
        ' first get the class we need to delete
        Dim aClass = PullClass(classID)
        If IsNothing(aClass) = True Then
            Return Failed("PullClass")
        End If
        If aClass.name = "" Then
            Return ErrorRoutine(-1, "class", "DeleteClass")
        End If
        ' first we need to delete the pools for this class
        Dim result As String = DeleteClassPools(classID)
        If result <> "" Then
            Return result
        End If
        ' now we need to delete the class it's self
        Try
            db.classes.DeleteOnSubmit(aClass)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteClass")
        End Try
    End Function

    Private Function GetClassID(ByVal name As String) As Integer
        Try
            Dim result = (From cls In db.classes _
                          Where cls.name = name _
                          Select cls).ToList
            If result.Count = 0 Then
                Return -1
            Else
                Return result(0).classID
            End If
        Catch ex As Exception
            _LastError = ex
            Return -2
        End Try
    End Function

    Private Function PullClass(ByVal classID As Integer) As [class]
        Try
            Dim result = (From aClass In db.classes _
                          Where aClass.classID = classID _
                          Select aClass).ToList
            If result.Count > 0 Then
                Return result(0)
            Else
                Return New [class]
            End If

        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Private Function CheckClassExists(ByVal name As String) As Boolean
        _causedError = False
        Try
            Dim result = (From aClass In db.classes _
                          Where aClass.name = name _
                          Select aClass).ToList
            If result.Count = 0 Then
                Return False
            Else
                Return True
            End If
        Catch ex As Exception
            _LastError = ex
            _causedError = True
            Return False
        End Try
    End Function

#End Region

#Region "Guild Code"
    Public Function AddGuild(ByVal guildXML As String) As String
        Dim _guild As New CharacterGuild
        _guild.LoadXML(guildXML)
        If CheckGuildExists(_guild.Name) = True Then
            If _causedError = True Then
                Return Failed("CheckGuildExists")
            End If
            Return "[#]guildexists"
        Else
            If _causedError = True Then
                Return Failed("CheckGuildExists")
            End If
        End If
        Dim aGuild As New guild
        aGuild.name = _guild.Name
        aGuild.description = _guild.Description
        aGuild.initialClassID = _guild.InitialClassID
        ' Skill doesn't exist already so we can now add the skill
        Try
            db.guilds.InsertOnSubmit(aGuild)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("AddGuild")
        End Try
    End Function

    Public Function UpdateGuild(ByVal guildXML As String) As String
        Dim _guild As New CharacterGuild
        _guild.LoadXML(guildXML)
        Dim aGuild As guild = PullGuild(_guild.ID)
        If IsNothing(aGuild) Then
            Return Failed("PullGuild")
        ElseIf aGuild.name = "" Then
            Return "[#]guildnotexist[" + _guild.ID.ToString + "]"
        End If
        aGuild.name = _guild.Name
        aGuild.description = _guild.Description
        aGuild.initialClassID = _guild.InitialClassID
        Try
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("UpdateGuild")
        End Try

    End Function

    Public Function DeleteGuild(ByVal guildID As Integer) As String
        Dim aGuild As guild = PullGuild(guildID)
        If IsNothing(aGuild) = True Then
            Return Failed("PullGuild")
        End If
        If aGuild.name = "" Then
            Return "[#]guildnotexist[" + guildID.ToString + "]"
        End If

        Try
            db.guilds.DeleteOnSubmit(aGuild)
            db.SubmitChanges()
            Return ""
        Catch ex As Exception
            _LastError = ex
            Return Failed("DeleteGuild[" + guildID.ToString + "]")
        End Try
    End Function

    Private Function PullGuild(ByVal guildID As Integer) As guild
        Try
            Dim result = (From guild In db.guilds _
                                  Where guild.guildID = guildID _
                                  Select guild).ToList
            If result.Count > 0 Then
                Return result(0)
            Else
                Return New guild
            End If

        Catch ex As Exception
            _LastError = ex
            Return Nothing
        End Try
    End Function

    Private Function CheckGuildExists(ByVal name As String) As Boolean
        _causedError = False
        Try
            Dim result = (From guild In db.guilds _
                                 Where guild.name = name _
                                 Select guild).ToList
            If result.Count = 0 Then
                Return False
            Else
                Return True
            End If
        Catch ex As Exception
            _LastError = ex
            _causedError = True
            Return False
        End Try
    End Function

    Public Function GetGuilds() As String
        Try
            Dim guildListXML = <guilds>
                                   <%= From guild In db.guilds _
                                       Select <guild id=<%= guild.guildID %>>
                                                  <name><%= guild.name %></name>
                                              </guild> %>
                               </guilds>
            Return guildListXML.ToString()
        Catch ex As Exception
            _LastError = ex
            Return Failed("GetGuilds")
        End Try
    End Function

    Public Function GetGuild(ByVal guildID As Integer) As String
        ' lets generate a CharacterGuild object 
        Dim _guild As New CharacterGuild
        ' first we need to get the general class information added to _class
        Dim aGuild As guild = PullGuild(guildID)
        If IsNothing(aGuild) Then
            Return Failed("GetGuild")
        ElseIf aGuild.name = "" Then
            Return ErrorRoutine(-1, "guild(" + guildID.ToString + ")", "GetGuild")
        End If
        _guild.ID = aGuild.guildID
        _guild.Name = aGuild.name
        _guild.Description = aGuild.description
        _guild.InitialClassID = aGuild.initialClassID

        ' Now let the CharacterGuild class generate the XML for us
        Return _guild.ToXElement.ToString
    End Function

#End Region

#Region "General Code"

    Public Function ErrorRoutine(ByVal errCode As Integer, ByVal context As String, ByVal routine As String) As String
        Select Case errCode
            Case -1
                Return "[#]" + context + "notexist[" + routine + "]"
            Case -2
                Return Failed(routine)
            Case -3
                Return "[#]" + context + "permissiondenied[" + routine + "]"
            Case -4
                Return "[#]" + context + "[" + routine + "]"
            Case Else
                Return "[#]" + context + "unknowncode[" + routine + "]"
        End Select
    End Function

    Public Function Failed(ByVal routine As String) As String
        Return "[#]failed[" + routine + "]|" + _LastError.ToString
    End Function

    Public Function FailedXML(ByVal routine As String, ByVal xmlData As String) As String
        Return "[#]failed[" + routine + "]|" + _LastError.ToString + vbCrLf + vbCrLf + xmlData
    End Function

    Public ReadOnly Property LastError() As Exception
        Get
            Return _LastError
        End Get
    End Property

#End Region

End Class
